home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / CRS / crs40.d81 / dodge.arc / DODGE.PAS < prev   
Pascal/Delphi Source File  |  2009-10-10  |  12KB  |  382 lines
  1.    program dodge (input, output);
  2.    const
  3.       numattackers = 6;
  4.       length       = 30;
  5.       width        = 15;
  6.       numines      = 15;
  7.       ninemax      = 2;
  8.    type
  9.       what = (me, attacker, tank, mine, nothing);
  10.      xindex = 0..length;
  11.      yindex = 0..width;
  12.      direction = (stay, n, ne, e, se, s, sw, w, nw, nowhere);
  13.      loc = record
  14.         xcord : xindex;
  15.         ycord : yindex;
  16.      end;
  17.    var
  18.       square : array [1..width,1..length] of what;
  19.       tankloc : loc;
  20.       myloc   : loc;
  21.       atack   : array [1..numattackers] of loc;
  22.       ch      : char;
  23.       left    : 0..numattackers;
  24.       nines   : 0..ninemax;
  25.       continue: char;
  26.    procedure makeboard;
  27.    var
  28.       placed : integer;
  29.       xloc   : xindex;
  30.       yloc   : yindex;
  31.       i,j    : integer;
  32.    begin
  33.       nines := ninemax;
  34.       for i := 1 to width do
  35.          for j := 1 to length do
  36.             square [i][j] := nothing;
  37.       left := numattackers;
  38.       for i := 1 to length do
  39.       begin
  40.          square [1][i] := mine;
  41.          square [width][i] := mine;
  42.       end;
  43.       for i := 1 to width do
  44.       begin
  45.          square [i][1] := mine;
  46.          square [i][length] := mine;
  47.       end;
  48.          placed := 0;
  49.          while placed < numines do
  50.          begin
  51.             xloc := random mod length + 1;
  52.             yloc := random mod width + 1;
  53.             if square [yloc][xloc] = nothing then
  54.             begin
  55.                square [yloc][xloc] := mine;
  56.                placed := placed + 1;
  57.             end;
  58.          end;
  59.          placed := 1;
  60.          while placed <= numattackers do
  61.          begin
  62.             xloc := random mod length + 1;
  63.             yloc := random mod width + 1;
  64.             if square [yloc][xloc] = nothing then
  65.             begin
  66.                square [yloc][xloc] := attacker;
  67.                atack [placed].xcord := xloc;
  68.                atack [placed].ycord := yloc;
  69.                placed := placed + 1;
  70.             end;
  71.          end;
  72.          while square [yloc][xloc] <> nothing do
  73.          begin
  74.             xloc := random mod length + 1;
  75.             yloc := random mod width + 1;
  76.          end;
  77.          square [yloc][xloc] := tank;
  78.          tankloc.xcord := xloc;
  79.          tankloc.ycord := yloc;
  80.          while square[yloc][xloc] <> nothing do
  81.          begin
  82.             xloc := random mod length + 1;
  83.             yloc := random mod width + 1;
  84.          end;
  85.          square [yloc][xloc] := me;
  86.          myloc.xcord := xloc;
  87.          myloc.ycord := yloc
  88.       end;
  89.   (*  end;  *)
  90.       procedure print;
  91.       var
  92.          i : xindex;
  93.          j : yindex;
  94.       begin
  95.          for j := 1 to width do
  96.          begin
  97.             for i := 1 to length do
  98.                case square [j][i] of
  99.                   me       : write ('*');
  100.                   tank     : write ('T');
  101.                   attacker : write ('$');
  102.                  mine     : write ('X');
  103.                  nothing  : write (' ');
  104.               end;
  105.            writeln ;
  106.         end;
  107.      end;
  108.      function move
  109.      (var curx : xindex;
  110.       var cury : yindex;
  111.       where    : direction):what;
  112.      begin
  113.         case where of
  114.            n     :  cury := cury - 1;
  115.            stay  :  ;
  116.            s     :  cury := cury + 1;
  117.            w     :  curx := curx - 1;
  118.            e     :  curx := curx + 1;
  119.            nw    :  begin
  120.                        curx := curx - 1;
  121.                        cury := cury - 1;
  122.                     end;
  123.            sw    :  begin
  124.                        curx := curx - 1;
  125.                        cury := cury + 1;
  126.                     end;
  127.            ne    :  begin
  128.                        curx := curx + 1;
  129.                        cury := cury - 1;
  130.                     end;
  131.            se    :  begin
  132.                        curx := curx + 1;
  133.                        cury := cury + 1;
  134.                     end;
  135.      end;
  136.      move := square [cury][curx]
  137.   end;
  138.   function ask:what;
  139.   var
  140.      command : array ['0'..'9'] of direction; (* command list *)
  141.      dir     : direction;
  142.      ch      : char;
  143.   begin
  144.      dir := stay;
  145.      for ch := '0' to '9' do
  146.      begin
  147.         command [ch] := dir;
  148.         dir := succ(dir);
  149.      end;
  150.      (**)
  151.      window (1,16,40,24,1);
  152.      write ('Direction? ');
  153.      readln (ch);
  154.      if not (ch in ['0'..'9']) or ((ch = '9') and (nines = 0)) then
  155.      begin
  156.         writeln ('How is that?');
  157.         ask := ask;
  158.      end
  159.      else
  160.      begin
  161.         square [myloc.ycord][myloc.xcord] := nothing;
  162.         if ch = '9' then
  163.         begin
  164.            nines := nines - 1;
  165.            myloc.xcord := random mod length + 1;
  166.            myloc.ycord := random mod width + 1;
  167.            ch := '0';
  168.         end;
  169.         ask := move(myloc.xcord,myloc.ycord,command[ch]);
  170.         square[myloc.ycord][myloc.xcord] := me;
  171.      end;
  172.      window (0,0,79,24,0);
  173.   end;
  174.   procedure moveall;
  175.   var
  176.      i : 1..numattackers;
  177.      function which (curr : loc):direction;
  178.      var
  179.         xdir, ydir : direction;
  180.      begin
  181.         xdir := stay;
  182.         ydir := stay;
  183.         if myloc.xcord > curr.xcord then
  184.            xdir := e
  185.         else
  186.            if myloc.xcord < curr.xcord then
  187.               xdir := w;
  188.         if myloc.ycord > curr.ycord then
  189.            ydir := s
  190.         else
  191.            if myloc.ycord < curr.ycord then
  192.               ydir := n;
  193.         if (xdir = stay) or (ydir = stay) then
  194.         begin
  195.            if xdir = stay then
  196.               which := ydir
  197.            else
  198.               which := xdir
  199.         end
  200.         else
  201.         begin
  202.            case xdir of
  203.               w : if ydir = n then
  204.                      which := nw
  205.                   else
  206.                      which := sw;
  207.                e : if ydir = n then
  208.                       which := ne
  209.                    else
  210.                       which := se
  211.            end
  212.         end
  213.      end;
  214. (**)
  215.   procedure checkmove (i : integer; dir : what);
  216.   var
  217.      remember, index : 1..numattackers;
  218.   begin
  219.      case dir of
  220.         nothing : square[atack[i].ycord][atack[i].xcord] := attacker;
  221.         tank    : begin
  222.                      window (40,5,79,8,1);
  223.                      writeln ('The tank just destroyed an attacker');
  224.                      atack[i].xcord := 0;
  225.                      left := left - 1;
  226.                      window (0,0,79,24,0);
  227.                   end;
  228.         me      : begin
  229.                      window (40,6,79,9,1);
  230.                      writeln ('You just died!!!');
  231.                      myloc.xcord := 0;
  232.                      WINDOW (0,0,79,24,0);
  233.                   end;
  234.         attacker : begin
  235.                      for index := 1 to numattackers do
  236.                         if (atack[i].xcord = atack[index].xcord) and
  237.                            (atack[i].ycord = atack[index].ycord) and
  238.                            (i <> index) then
  239.                               remember := index;
  240.                      window (40,07,79,24,1);
  241.                      writeln ('Two attackers just hit.');
  242.                      window (0,0,79,24,0);
  243.                      square [atack[remember].ycord][atack[remember].xcord]
  244.                             := nothing;
  245.                      atack[i].xcord := random mod length + 1;
  246.                      atack[i].ycord := random mod width + 1;
  247.                      checkmove (i,move(atack[i].xcord,atack[i].ycord,
  248.                                 which(atack[i])));
  249.                      atack [remember].xcord := random mod length + 1;
  250.                      atack [remember].ycord := random mod width + 1;
  251.                      checkmove (remember,move(atack[remember].xcord,
  252.                         atack[remember].ycord,which(atack[remember])));
  253.                   end;
  254.         mine    : begin
  255.                      window (40,7,79,10,1);
  256.                      writeln ('An attacker just hit a mine.');
  257.                      atack[i].xcord := 0;
  258.                      left := left - 1;
  259.                      window (0,0,79,24,0);
  260.                   end;
  261.         end;
  262.      end;
  263.   begin
  264.      for i := 1 to numattackers do
  265.      begin
  266.         if atack[i].xcord > 0 then
  267.         begin
  268.            square[atack[i].ycord][atack[i].xcord] := nothing;
  269.            checkmove (i,move(atack[i].xcord, atack[i].ycord,which(atack[i])))
  270.         end;
  271.      end;
  272.      square[tankloc.ycord][tankloc.xcord] := nothing;
  273.      case move(tankloc.xcord,tankloc.ycord,which(tankloc)) of
  274.         attacker : begin
  275.                       window (40,9,79,12,1);
  276.                       writeln (' the tank just destroyed an attacker.');
  277.                       window (0,0,79,24,0);
  278.                       left := left - 1;
  279.                       for i := 1 to numattackers do
  280.                          if (atack[i].xcord = tankloc.xcord) and (atack[i].ycord = tankloc.ycord) then
  281.                             atack[i].xcord := 0
  282.                    end;
  283.         mine     : begin
  284.                       window (40,5,79,24,1);
  285.                       writeln ('The tank just destroyed a mine.');
  286.                       window (0,0,79,24,0);
  287.                    end;
  288.         me       : begin
  289.                       window (40,10,79,13,1);
  290.                       writeln ('The tank just destroyed you!');
  291.                       window (0,0,79,24,0);
  292.                       myloc.xcord := 0
  293.                    end;
  294.         nothing  :
  295.      end;
  296.      square[tankloc.ycord][tankloc.xcord] := tank;
  297.   end;
  298.   (**)
  299.   procedure inst;
  300.   begin
  301.      page ;
  302.      writeln ('                             *** DODGE ***');
  303.      writeln ;
  304.      writeln ('You are in a 30 by 15 square. There are ',numattackers:2,' attackers, one tank, and you.');
  305.      writeln ('If you hit one of the attackers (or the tank) you are destroyed.');
  306.      writeln ('If two attackers hit each other they are randomly put somewhere else on the');
  307.      writeln ('battlefield. If an attacker runs into the tank (or vice versa) then he is');
  308.      writeln ('destroyed. As an added bonus there are ',numines:2,' mines in the battlefield, and');
  309.      writeln ('and border of the square. Only the tank is immune to the explosion of a mine.');
  310.      writeln ('You must destroy at least 6 attackers to win the game. Moving your player is');
  311.      writeln ('accomplished by using the numeric keypad as illustrated below.');
  312.      writeln ;
  313.      writeln ('**NOTE - Pressing 0 leaves you in the same place.');
  314.      writeln ('       - Pressing 9 places you randomly in the square.');
  315.      writeln ;
  316.      writeln ('                   NORTH         9 = TRANSPORT ');
  317.      writeln ('                     1');
  318.      writeln ('    NORTH/WEST 8     :     2 NORTH/EAST');
  319.      writeln ('                     :');
  320.      writeln ('       WEST 7 .......0....... 3  EAST');
  321.      writeln ('                     :');
  322.      writeln ('    SOUTH/WEST 6     :     4 SOUTH/EAST');
  323.      writeln ('                     5');
  324.      writeln ('                   SOUTH');
  325.      writeln ;
  326.   end;
  327.   (* main program *)
  328.   begin
  329.      page;
  330.      writeln ('                                      Dodge');
  331.      writeln ;
  332.      writeln ('Original program by   : Joseph Kalash as published in');
  333.      writeln ('                        Apple Pascal Games (c) 1981 SYBEX Inc');
  334.      writeln ;
  335.      writeln ('Ported to the C128 by : Stephen A. Bungay');
  336.      writeln ('                        DSA Associates.');
  337.      writeln ;
  338.      writeln ('       Written using Oxford Pascal by Systems Software (Oxford) Limited.');
  339.      writeln;
  340.      write ('                          Do you want instructions? ');
  341.      readln (ch);
  342.      if (ch = 'Y') or (ch = 'y') then
  343.      begin
  344.         inst;
  345.         write ('PRESS RETURN TO CONTINUE....');
  346.         read (continue);
  347.         writeln ;
  348.         page;
  349.      end;
  350.      repeat
  351.         page ;
  352.         makeboard;
  353.         print;
  354.         while (myloc.xcord <> 0) and (left > 0) do
  355.         begin
  356.            if ask <> nothing then
  357.               myloc.xcord := 0
  358.            else
  359.            begin
  360.               moveall;
  361.               write (chr(19));
  362.               print;
  363.            end;
  364.            writeln;
  365.         end;
  366.         if myloc.xcord = 0 then
  367.         begin
  368.            window (40,15,79,24,1);
  369.            writeln ('Well, you got yourself killed!!')
  370.         end
  371.         else
  372.         begin
  373.            window (40,15,79,24,1);
  374.            writeln ('Congratulations, you did it!!');
  375.         end;
  376.         writeln;
  377.         write ('Want to try again? ');
  378.         readln (ch);
  379.         window (0,0,79,24,1);
  380.      until ch <> 'y';
  381.   end.
  382.